{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE EmptyDataDecls        #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE RankNTypes    #-}
module Language.Map.Map where

import Generics.MultiRec.Base
import Generics.MultiRec.Show as GS
import Generics.MultiRec.Zipper 
import Generics.MultiRec.TH.Alt
import Data.Maybe
import Data.Dynamic
import Data.Typeable

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Pos
import Text.ParserCombinators.Parsec.Prim
import Text.ParserCombinators.Parsec.Token

import Unsafe.Coerce

data SourceSpan = SrcSpan { srcFrom :: SourcePos, srcTo :: SourcePos } deriving (Typeable, Show)

--data Offset = O Int Int deriving (Typeable, Show)  --replaced by SourceSpan

data Entry = E Char Int SourceSpan deriving (Typeable, Show)

data Map = Empty SourceSpan
         | Cons Entry Map SourceSpan deriving (Typeable, Show) 

-- ** Index type

data MAP :: * -> * where
  TheEntry  ::  MAP Entry
  TheMap  ::  MAP Map
  TheSourceSpan :: MAP SourceSpan
  deriving (Typeable)


-- ** Parser

entry :: Parser Entry
entry = do 
          many space
          srcFrom <- getPosition
          char '('
          many space
          c <- letter
          many space
          char ':'
          many space
          i <- natParser
          many space
          char ')'
          srcTo <- getPosition
          many space
          return (E c i (SrcSpan srcFrom srcTo))


mapp :: Parser Map
mapp = (do
         many space
         srcFrom <- getPosition
         e <- entry
         many space
         char ';'
         many space
         m <- mapp
         srcTo <- getPosition
         many space
         return (Cons e m (SrcSpan srcFrom srcTo))
       <|> do 
             p <- getPosition
             return (Empty (SrcSpan p p)))


natParser = do
  { number <- many digit
  ; return (read number::Int)
  }

$(deriveEverything
  (DerivOptions
    [ ( [t| Entry |] ,"TheEntry")
    , ( [t| Map |] ,"TheMap")
    , ( [t| SourceSpan |] ,"TheSourceSpan")
    ]
   "MAP"
   (\t c -> "CONSTRUCTOR_" ++ t ++ "_" ++ c)
   "MAPPF"
   True
   Balanced
  )
 )


type instance PF MAP = MAPPF


-- can be used as parser ...

dummySpan = SrcSpan (newPos "not_parsed" (-1) (-1)) (newPos "not_parsed" (-1) (-1))

fromList :: [(Char,Int)] -> Map
fromList ((k,v):es) = Cons (E k v dummySpan) (fromList es) dummySpan
fromList _ = Empty dummySpan

toList :: Map -> [(Char,Int)]
toList (Empty _) = []
toList (Cons (E k v _) l _) = (k,v):(toList l)

focusMAP :: Maybe (Loc MAP I0 Map) -> Char
focusMAP (Just l) = on key l
  where key :: MAP ix -> I0 ix -> Char
        key TheEntry (I0 ( E k v _)) = k
